perm filename RESPC.F4[MSS,LCS]3 blob
sn#247591 filedate 1976-11-11 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE RESPC
C00014 ENDMK
Cā;
SUBROUTINE RESPC
COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
1 /IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),
1 RCLEF(-3/4) /IVV/IV(1)
COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
C ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
C INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),
1 KPN(1),RSIG(-3/4),RMETER(-3/4),RCL(-3/4)
COMMON /PX/PN(1) /Q/Q(1)
1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
1 /KBAR/KBAR(512)
1 /RSP/KNM(10),ENDLN,KQ,NAME,NMPG,SPCNT
DATA FIB/.8/ ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/
C RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
1,(MM,RN),(NN,RN(1501)),(KPN,PN),(KS,RS),(BARS,KBAR(4))
1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46))
C RQ(2) IS R4, RQ(3) IS R5 ETC.
SPCNT=1.0
JX=0
XT=0
PX=0
CALL SHFT1(KQ)
KK=L
CC TYPE 3001,L
C DELETES EXTRA BAR LINES, ETC.
IF(IPG)CALL RESTS
C FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
CALL SHIFT
C L=NUMBER OF ITEMS FOR RHY RECONS.
N=0
S=-100
R=0
KCLEF=0
DO 601 K=1,L
R=CODEN(KPN,K,Q,J)
CX J=KPN(K)
CC N=N+1
CC NN(N)=0
CC MM(N)=J+3
CALL MMNN(3)
CX R=Q(J+1)
801 IF(R.NE.1)GO TO 1801
IF(Q(J+8).EQ.1000)GO TO 601
C SKIP SLASHED GRACE NOTE. *****
GO TO 702
1801 IF(R.LT.4)GO TO 702
IF(R.EQ.17)GO TO 702
IF(R.EQ.18)GO TO 1702
IF(R.LE.7)GO TO 30
IF(R.NE.44)GO TO 601
IF(Q(J+6).EQ.0)GO TO 601
IF(Q(J+5).EQ.0)GO TO 601
C GETS LEFT END OF LINES, CRESC., DASHES.
GO TO 604
30 IF(R.NE.7)GO TO 605
IF(Q(J).LT.5)GO TO 604
C JUMP FOR STANDARD TRILL
RS=RN(J+7)
IF(RS.EQ.1)GO TO 604
IF(ABS(RS).GE.3)GO TO 604
C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
GO TO 601
605 IF(R.NE.4)GO TO 604
IF(Q(J).EQ.2)GO TO 702
C JUMP IF IT IS A BAR LINE
IF(Q(J).LT.4)GO TO 601
IF(Q(J+6).NE.0)GO TO 604
C GO GET OTHER POS OF LINE
GO TO 601
1702 IF(Q(J+4).NE.0)GO TO 601
C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
702 NN(N)=R
GO TO 601
C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
604 CALL MMNN(6)
C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS
IF(R.NE.6)GO TO 601
C NEXT FOR BEAMS
RZ=Q(J)
IF(RZ.LT.8)GO TO 608
IF(Q(J+10).EQ.0)GO TO 608
IF(Q(J+7).GT.0)CALL MMNN(8)
C NEXT SHIFTS P8 OF COMPOSITE BEAMS
608 IF(RZ.LT.7)GO TO 601
IF(Q(J+7))GO TO 688
C P7 IS NEG FOR TREMOLO
IF(Q(J+8).EQ.0)GO TO 601
C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
688 IF(Q(J+9).GT.0)CALL MMNN(9)
C FOUND A POS. IN P9
601 CONTINUE
C NEXT SORTS THE POINTS
6000 J=1
610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
CALL EXCHG(MM(J),NN(J))
C ABOVE EXCHGS --(J) AND --(J+1)
IF(J.EQ.1)GO TO 710
J=J-1
GO TO 610
710 J=J+1
IF(J.LT.N)GO TO 610
C NOW ALL SORTED
IF(NMPG.EQ.'PAGEA')KLEF=0
CARES ABOUT CLEFS ONLY AT VERY FIRST.
K=0
2703 K=K+1
M=NN(K)
IF(M.EQ.0)GO TO 703
S=Q(MM(K))
C POS OF THIS ITEM
KW=K
IF(M.LT.3)GO TO 1703
RZ=.8
IF(M.NE.3)GO TO 4703
7777 IF(KLEF)GO TO 5703
C LOOK AT CLEFS ONLY ONCE.
KLEF=-1
4703 KW=KW+1
IF(KW.GT.N)GO TO 703
IF(NN(KW).EQ.0)GO TO 4703
RT=Q(MM(KW))-S
C SPACE BETWEEN THIS AND NEXT ITEM
IF(RT.GT.RZ)GO TO 703
NN(KW-1)=0
K=KW
GO TO 4703
5703 NN(K)=0
GO TO 703
1703 KW=KW+1
IF(KW.GT.N)GO TO 703
RT=Q(MM(KW))-S
C SPACE BETWEEN THIS AND NEXT ITEM
IF(RT.LT.SPCNT)GO TO 1703
7703 IF(KW-K.EQ.1)GO TO 703
KW=KW-1
IF(NN(KW).EQ.0)GO TO 7703
8703 DO 6703 J=K,KW-1
M=NN(J)
IF(M.GT.2)M=0
6703 NN(J)=-M
C FOR ITEMS BETWEEN 2 POINTS, CHANGES 1,2 TO -1,-2; OTHERS TO 0.
K=KW
703 IF(K.LT.N)GO TO 2703
J=0
1710 J=J+1
IF(NN(J).LE.0)GO TO 1710
C FIND 1ST IMPORTANT ITEM. PUT POS IN S2 AND P1
S2=Q(MM(J))
P1=S2
612 IF(NN(J).EQ.0)GO TO 613
7102 M=J+1
S1=S2
LS=0
616 IF(NN(M).GT.0)GO TO 614
IF(M.EQ.N)GO TO 614
1616 M=M+1
C M WILL POINT TO NEXT IMPORTANT ITEM.
GO TO 616
C ASSUMES PROPER END OF LIST
614 K=MM(J)
RZ=Q(K)
7104 R=Q(K-2)
C THE CODE #
IF(R.GT.2)GO TO 618
RT=9-R*2
P=Q(K+IFIX(RT)-1)
IF(Q(K-3).LT.RT)P=100.0
C WAS THERE A RHYTH VALUE?
LS=J
IF(P.LT.1)GO TO 606
IF(NN(M).EQ.4)GO TO 606
C CUT DOWN SPACE AFTER QUARTER OR GREATER IF NEXT IS 3,17,18
IF(NN(M).GT.2)P=P/2
606 IF(XT.EQ.0)GO TO 3606
X=P
IF(ABS(XT-P).LT..01)GO TO 4606
C FOR ROUNDOFF PROBLEMS WITH TRIPLETS, ETC.
IF(P.LT.XT)GO TO 2606
4606 P=XT
C FOR NON-COINCIDENTAL RHYTHMS
XT=X-P
GO TO 3606
2606 XT=XT-P
3606 IF(ABS(XT).LT..01)XT=0
LS=LS-1
IF(LS.EQ.0)GO TO 607
C NEXT CHECKS ON ALL NEARBY RHYTHMS
LA=MM(LS)
CC IF(ABS(Q(LA)-RZ).GT.SPCNT)GO TO 607
IF(RZ-Q(LA).GT.SPCRX)GO TO 607
IF(NN(LS).GE.0)GO TO 3606
C GO BACK IF NOT NOTE OR REST (1,2 -1,-2)
RT=Q(LA-2)
CC IF(RT.GT.3)GO TO 3606
C LOOK AT NOTES AND RESTS ONLY
IF(Q(LA-3).LT.9-RT*2)GO TO 3606
C JUMP IF NO RHYTHM ON THIS NOTE
LC=LA+8-RT*2
C LC IS PARAM FOR RHYTH IN REST OR NOTE
CC IF(Q(LC).GE.P)GO TO 3606
CC P=Q(LC)
C GETS SMALLEST RHYTHM
RT=Q(LC)
CC IF(RT.LT.P)P=RT
IF(ABS(RT-P).LT..01)RT=P
IF(RT.EQ.P)GO TO 3606
IF(RT.LT.P)GO TO 1606
C FOR NON-COINCIDENTAL RHYTHMS
XT=RT-P
GO TO 3606
1606 XT=P-RT
P=RT
GO TO 3606
607 IF(P.EQ.100)P=1
IF(R.NE.2)GO TO 615
IF(P.LT..2)P=.2
C 32ND, 64TH RESTS GET BIGGER!
615 IF(JX)GO TO 609
IF(P.LT..125)P=.125
C NOW MOVE EVERYTHING FROM J+1 ON.
GO TO 609
CC629 IF(Q(K+5).EQ.1000)GO TO 630
CC IF(Q(K-3).GE.8.AND.Q(K+7).EQ.1)GO TO 630
C GRACE NOTES R8=1000 OR R10=1
CC IF(P.GE..25)GO TO 617
618 IF(R.EQ.3)P=5
IF(R.EQ.4)P=2.6
IF(R.GE.17)P=3.
IF(R.NE.9)GO TO 628
C FOR BAR REPEAT SIGN. =HALF NOTE SPACE
P=2.
CC630 P=.05
C FOR GRACE NOTES
CC617 IF(P.EQ.0)P=1
CC IF(P.LT..125)P=.125
609 IF(P.GT.8)P=8
C********************
IF(XT.EQ.0.AND.JX.EQ.0)GO TO 2609
JX=-1
RX=P
IF(PX.NE.0)GO TO 3609
PX=P
CCCCC IF(P.GT.XT)P=XT
QX=P
3609 P=QX
GO TO 1609
2609 PX=0
1609 P=(P+(.125-P)*FIB)*RSPC
IF(PX.NE.0)P=P*RX/QX
IF(P.GT.18)P=P-P/7
C MAKE THIS BETTER!!!!
IF(XT.NE.0)GO TO 628
JX=0
PX=0
628 K=MM(M)
S2=Q(K)
P2=P1+P
Q(K)=P2
IF(M-J.EQ.1)GO TO 7103
C NEXT ADJUSTS STUFF IN BETWEEN
R=P/(S2-S1)
DO 620 K=J+1,M-1
LA=MM(K)
620 Q(LA)=P1+R*(Q(LA)-S1)
7103 P1=P2
J=M
IF(J.LT.N)GO TO 7102
613 J=J+1
IF(J.LT.N)GO TO 612
C ALL DONE!
C*** IF(XLFT.EQ.0)GO TO 600
C NEXT MOVES LEFT SIDE OF STAFF TO ZERO
CALL PUTFIL(NMPG)
2929 JJ2=L+2
LCNT=0
NDPY=0
JPQ=KPN(L+1)+1
CALL FASTOU(RSTFAC,128)
CALL FASTOU(PN,JJ2)
CALL FASTOU(Q,JPQ)
CALL FINFIL
LASTNM=NMPG
DO 12 J=1,L
LA=KPN(J)
IF(Q(LA+1).NE.4)GO TO 12
KBR=KBR+1
C BAR LINE COUNTER
T=Q(LA+3)
C TOTAL SPACE
IF(NEXTB.GE.0)GO TO 222
T=T+5
C EXTRA SPACE FOR METER FROM END OF PREV. LINE.
NEXTB=0
222 BARS(KBR)=T-ENDLN
C SIZE OF THIS MEASURE
ENDLN=T
12 CONTINUE
IF(K.EQ.L)GO TO 122
NEXTB=-1
ENDLN=Q(KPN(L)+3)
122 NMPG=NMPG+2
KNM(1)=KNM(1)+2
END